home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 20 / Cream of the Crop 20 (Terry Blount) (1996).iso / comm / cpt152.zip / CPT-S152.ZIP / CPT-FIX.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-16  |  7KB  |  257 lines
  1. PROGRAM FixCPT;
  2. {$M 5120,0,655360}
  3. {$N-,E- no math support needed}
  4. {$X- function calls may not be discarded}
  5. {$I- disable I/O checking (trap errors by checking IOResult)}
  6.  
  7. USES DOS;
  8. CONST
  9.   progdesc = 'CPT-Fix - Fix CPT v1.36 database files.';
  10.   author   = 'Copyright (c) September 29, 1995, by David Daniel Anderson - Reign Ware.';
  11.  
  12. PROCEDURE showhelp (problem : BYTE);
  13. {----
  14.  If any *foreseen* errors arise, we are sent here,
  15.   to give a little help and exit (relatively) peacefully
  16. ----}
  17. CONST
  18.   usage    = 'Usage:  CPT-Fix <CPT v1.36 file(s)>';
  19. VAR
  20.   message : STRING [79];
  21. BEGIN
  22.   WriteLn;
  23.   IF (problem > 0) THEN BEGIN
  24.     CASE (problem) OF
  25.       1 : message := 'Invalid parameter on command line or parameter missing.';
  26.       2 : message := 'No files found.  First parameter must be a valid file specification.';
  27.       7 : message := 'File handling error.  File may have been corrupted or deleted!';
  28.       ELSE  message := 'Undefined error.'
  29.     END;
  30.     WriteLn (#7, 'Error encountered (#', ExitCode, '):'); WriteLn (message); WriteLn;
  31.   END;
  32.   WriteLn (usage);
  33.   Halt (problem);
  34. END;
  35.  
  36. PROCEDURE CheckIO;
  37. BEGIN
  38.   IF IOResult <> 0 THEN ShowHelp (7);
  39. END;
  40.  
  41. FUNCTION Upper (w: STRING): STRING;
  42. VAR
  43.   cp : INTEGER;        {The position of the character to change.}
  44. BEGIN
  45.   FOR cp := 1 TO Length (w) DO
  46.     w [cp] := UpCase (w [cp]);
  47.   Upper := w;
  48. END;
  49.  
  50. FUNCTION IsFile (CONST FileName: PATHSTR): BOOLEAN;
  51. VAR
  52.   Attr  : WORD;
  53.   cFile : FILE;
  54. BEGIN
  55.   Assign (cFile, FileName);
  56.   GetFAttr (cFile, Attr);
  57.   IF (DosError = 0) AND ((Attr AND Directory) <> Directory)
  58.     THEN IsFile := TRUE
  59.     ELSE IsFile := FALSE;
  60. END;
  61.  
  62. PROCEDURE EraseFile (CONST FileName : STRING);
  63. VAR
  64.   cFile : FILE;
  65. BEGIN
  66.   IF IsFile (FileName) THEN BEGIN
  67.     Assign (cFile, FileName);
  68.     SetFAttr (cFile, 0);
  69.     Erase (cFile); CheckIO;
  70.   END;
  71. END;
  72.  
  73. FUNCTION GetName (fn : STRING): STRING;
  74. BEGIN
  75.   IF (Pos ('.', fn) > 0)
  76.     THEN GetName := Copy (fn, 1, (Pos ('.', fn) - 1))
  77.     ELSE GetName := fn;
  78. END;
  79.  
  80. FUNCTION GetExt (fn : STRING): STRING;
  81. BEGIN
  82.   IF (Pos ('.', fn) > 0)
  83.     THEN GetExt := Copy (fn, Pos ('.', fn), Length (fn))
  84.     ELSE GetExt := '';
  85. END;
  86.  
  87. FUNCTION IsDir (CONST FileName: PATHSTR): BOOLEAN;
  88. VAR
  89.   Attr  : WORD;
  90.   cFile : FILE;
  91. BEGIN
  92.   Assign (cFile, FileName);
  93.   GetFAttr (cFile, Attr);
  94.   IF (DosError = 0) AND ((Attr AND Directory) = Directory)
  95.     THEN IsDir := TRUE
  96.     ELSE IsDir := FALSE;
  97. END;
  98.  
  99. FUNCTION GetFilePath (CONST PSTR: STRING; VAR sDir: DIRSTR): PATHSTR;
  100. VAR
  101.   jPath     : PATHSTR;  { file path,       }
  102.   jDir      : DIRSTR;   {      directory,  }
  103.   jName     : NAMESTR;  {      name,       }
  104.   jExt      : EXTSTR;   {      extension.  }
  105. BEGIN
  106.   jPath := PSTR;
  107.   IF jPath = '' THEN jPath := '*.*';
  108.   IF (NOT (jPath [Length (jPath)] IN [':', '\'])) AND IsDir (jPath) THEN
  109.     jPath := jPath + '\';
  110.   IF (jPath [Length (jPath)] IN [':', '\']) THEN
  111.     jPath := jPath + '*.*';
  112.  
  113.   FSplit (FExpand (jPath), jDir, jName, jExt);
  114.   jPath := jDir + jName+ jExt;
  115.  
  116.   sDir := jDir;
  117.   GetFilePath := jPath;
  118. END;
  119.  
  120. FUNCTION FixLine (VAR FILE1, FILE2 : TEXT): BOOLEAN;
  121. VAR
  122.   cline : STRING;
  123.   return : BOOLEAN;
  124. BEGIN
  125.   return := FALSE;
  126.   ReadLn (FILE1, cline);
  127.   IF Copy (cline, 1, 9) = 'CPT v1.36' THEN BEGIN
  128.     return := TRUE;
  129.     cline [9] := '7';
  130.     WriteLn (FILE2, cline);
  131.     WHILE (NOT EoF (FILE1)) DO BEGIN
  132.       ReadLn (FILE1, cline);
  133.       IF (Copy (cline, 1, 2) = ': ') AND (cline [38] <> ',') THEN BEGIN
  134.         Insert (',', cline, 38);
  135.         WHILE cline[55]=#32 DO BEGIN
  136.           Delete (cline, 55, 1);
  137.           Insert ('?', cline, 48);
  138.         END;
  139.         WHILE cline[68]=#32 DO BEGIN
  140.           Delete (cline, 68, 1);
  141.           Insert ('?', cline, 61);
  142.         END;
  143.       END;
  144.       cline[50] := '-';
  145.       cline[53] := '-';
  146.       cline[63] := '-';
  147.       cline[66] := '-';
  148.       WriteLn (FILE2, cline)
  149.     END;
  150.   END;
  151.   FixLine := return;
  152. END;
  153.  
  154. {---- TYPEs, CONSTs and VARs for "main" program ----}
  155. TYPE
  156.   FileList = ^FILEREC;
  157.   FILEREC = RECORD
  158.               Name : STRING [12];
  159.               next : FileList;
  160.             END;
  161.  
  162. VAR
  163.   dirinfo : SEARCHREC;
  164.   spath   : PATHSTR;
  165.   sdir    : DIRSTR;
  166.   sfn, dfn,
  167.   Swapname : PATHSTR;
  168.   infile, outfile : TEXT;
  169.  
  170.   anchor, chain : FileList;
  171.   okay,
  172.   done    : BOOLEAN;
  173.   Processed : word;
  174.  
  175.   fname : NAMESTR;
  176.  
  177. {---- BEGIN the "main" program ----}
  178.  
  179. BEGIN
  180.   WriteLn (progdesc);
  181.   WriteLn (author);
  182.   Processed := 0;
  183.  
  184.   IF ParamCount <> 1 THEN ShowHelp (1);
  185.   sPath := GetFilePath (ParamStr (1), sDir);
  186.  
  187.   anchor := NIL;
  188.  
  189.   FindFirst (spath, Archive, dirinfo);
  190.   IF (DosError <> 0) THEN showhelp (2);
  191.   WriteLn;
  192.  
  193. {---- Okay, let's go! ----}
  194.  
  195.   WHILE DosError = 0 DO
  196.   BEGIN
  197.     sfn := sdir + dirinfo. Name;
  198.     done := FALSE;
  199.     fname := GetName (dirinfo. Name);
  200.     IF (Upper (GetExt (dirinfo.Name)) = '.BAK') THEN done := TRUE;
  201.     chain := anchor;            { check if file was processed file already }
  202.     WHILE (chain <> NIL) AND (NOT done) DO
  203.       IF (chain^. Name = dirinfo. Name)
  204.         THEN done := TRUE
  205.         ELSE chain := chain^. next;
  206.  
  207. {---- Only process if not processed before ----}
  208.  
  209.     IF (NOT done) THEN BEGIN
  210.       Inc (Processed);
  211.       New (chain);
  212.       chain^. Name := dirinfo. Name; { add current name to beginning of list }
  213.       chain^. next := anchor;
  214.       anchor := chain;
  215.  
  216. {---- Process the file! ----}
  217.       dfn := sDir + fname + '.bak';
  218.       Write ('Checking ', sfn); {tell user file is being processed}
  219.  
  220.       Assign (infile, sfn); Reset (infile); CheckIO;
  221.       Assign (outfile, dfn); Rewrite (outfile); CheckIO;
  222.  
  223.       Okay := FixLine (infile, outfile);
  224.  
  225. {---- Close files, then find next file to process ----}
  226.  
  227.       IF Okay THEN
  228.       BEGIN
  229.         WriteLn (', adjusted.');
  230.         Close (infile);        CheckIO;
  231.         Close (outfile);       CheckIO;
  232.         Swapname := sDir + 'cpt!#$#!.swp';
  233.         Rename (infile, Swapname);  CheckIO;
  234.         Rename (outfile, sfn); CheckIO;
  235.         Rename (infile, dfn);  CheckIO;
  236. (*      Erase (infile);        CheckIO;  *)
  237.       END
  238.       ELSE BEGIN
  239.         WriteLn (', skipped.');
  240.         EraseFile (dfn);
  241.       END;
  242.     END;
  243.     FindNext (dirinfo);
  244.   END;     { now loop back with name of next file to process }
  245.  
  246. {---- dispose of pointers - not necessary at end, but good practice ----}
  247.  
  248.   WHILE chain <> NIL DO BEGIN
  249.     anchor := chain;
  250.     chain := chain^. next;
  251.     Dispose (anchor);
  252.   END;
  253.  
  254.   Writeln('Processed ',Processed, ' file(s).');
  255.  
  256. END. {main}
  257.